         sbt      "ProDOS main body"
         pag
* PR.3
*---------------------------------
;
;
;
;
*************************
*                       *
*       ProDOS          *
*                       *
* start of ProDOS code  *
* in RAMCARD            *
*                       *
*************************
;
;
;
L2D00:
;
;
         phs      $D000
;
;
;   ramcard MLI entry
;   save registers, and get the
;   address of the function call
;   and parmlist (follows the
;    JSR PRODOS)
;
ENTRYMLI cld      
         sty      SAVEY
         stx      SAVEX
;
;   pop stack address to get
;   parmlist pointer and save
;   return address (+4 to skip
;   the parms)
;
         pla
         sta      PARMS
         clc
         adc      #4
         sta      CMDADR
         pla
         sta      PARMS+1
         adc      #0
         sta      CMDADR+1
;
;   clear error, get function
;   byte
;
         ldy      #$00
         sty      SERR
         iny
         lda      (PARMS),Y
;
;   fold in to 5-bit number for
;   checking
;
         lsr
         lsr
         lsr
         lsr
         clc
         adc      (PARMS),Y
         and      #$1F
         tax
;
;   check to make sure it folded
;   correctly
;
         lda      (PARMS),Y
         cmp      LEF25,X
         bne      NOGOODFN
;
;   get pointer to parmlist
;
         iny
         lda      (PARMS),Y
         pha
         iny
         lda      (PARMS),Y
         sta      PARMS+1
         pla
         sta      PARMS
;
;   verify correct number of
;   parameters
;
         ldy      #$00
         lda      LEF45,X
         beq      >2                    ;GET.TIME has no parms
         cmp      (PARMS),Y
         bne      BADNMPRM
;
;   check function type
;
         lda      LEF25,X
         cmp      #QUIT
         beq      >1
;
         asl
         bpl      DODEVMLI              ;on $80-$81
         bcs      DOFILMLI              ;on $C0-$D3 
;
;   must be $40-$41
;   handle ALLOC/DEALLOC
;
         lsr
         and      #$03
         jsr      ALLDEALL
         jmp      MLIFIN
;
;   jump to QUIT handler
;
^1       jmp      JSPARE
;
;   go to date/time handler
;
^2       jsr      DATETIME
         jmp      MLIFIN
;
;   is disk command  ($80,$81)
;   convert to read=01 write=02
;   call to device handler and
;   execute it
;
DODEVMLI lsr      
         adc      #$01
         sta      DSKCMD
         jsr      DEVDRIVR
         jmp      MLIFIN
;
;   handle "main" calls to MLI
;   opcodes $C0-$D3
;   convert call back, get 5-bit
;   number, call main handler
;   and return
;
DOFILMLI lsr      
         and      #$1F
         tax
         jsr      FILHNDLR
;
;
;   MLI call finished
;   set up err (if one) and
;   restore registers, return
;   address and return
;
MLIFIN   lda      #0
         sta      BUBIT                 ;reset back-up bit
;
;   C=1 Z=0 on error, so set flags
;
         ldy      SERR
         cpy      #$01
         tya
         php
;
;   get return address, restore
;   registers
;
         sei
         lsr      MLIACTV               ;MLI not active any more
         pla                            ;get status byte
         tax
;
         lda      CMDADR+1              ;return address
         pha
         lda      CMDADR
         pha
;
         txa                            ;push status back
         pha
;
         tya                            ;err code
         ldx      SAVEX
         ldy      SAVEY
         pha
         lda      BNKBYT1               ;switch state back
         jmp      EXIT
;
;
;   errors
;
NODEVERR lda      #NODEVCON
         jsr      SYSERR                ;does not return
;
;
;
NOGOODFN lda      #$01
         bne      >4
;
BADNMPRM lda      #$04
^4       jsr      RSYSERR
         bcs      MLIFIN                ;always
;
;
;   call device driver to do
;   function call
;   set up block, buffer address
;
DEVDRIVR ldy      #5
         php
         sei
;
^1       lda      (PARMS),Y
         sta      DSKCMD,Y
         dey
         bne      <1
;
;   set up high byte boundary
;   beyond which read will not
;   go (for MEMORY page protect)
;
         ldx      DSKBUF+1
         stx      L4F
         inx
         inx
         lda      DSKBUF
         beq      >2
         inx
;
;   call medium-level handler
;
^2       jsr      LEE89
         bcs      >3                    ;err on call
         jsr      LD0DA                 ;performs actual call
         bcs      >3
         plp
         clc
         rts
;
;
^3       plp      
RSYSERR  jsr      SYSERR                ;does not return
;
;
;   get device number, call
;   device handler through
;   vector in table
;
LD0DA    lda      DSKDEV
         and      #$F0
         sta      DSKDEV
         lsr
         lsr
         lsr
         tax
         lda      DEVADR01,X
         sta      DEVJMP
         lda      DEVADR01+1,X
         sta      DEVJMP+1
         jmp      (DEVJMP)
;
;
;   ALLOC/DEALLOC interrupt
;   handler
;
ALLDEALL sta      DSKCMD
         lsr
         bcs      LD124
;
;   is ALLOC.INTERRUPT
;
         ldx      #$03
;
^4       lda      INTRUPT1 - 2,X
         bne      >5
         ldy      #$03
         lda      (PARMS),Y
         beq      LD11F
         sta      INTRUPT1 - 2,X
         dey
         lda      (PARMS),Y
         sta      INTRUPT1 - 3,X
         txa
         lsr
         dey
         sta      (PARMS),Y
         clc
         rts
;
;
^5       inx      
         inx
         cpx      #$0B
         bne      <4
;
;   error- table full
;
         lda      #$25
         bne      >7                    ;always taken
;
;
LD11F    lda      #BADPARM
^7       jsr      SYSERR
;
;
;   is DEALLOC.INTERRUPT
;
LD124    ldy      #$01
         lda      (PARMS),Y
         beq      LD11F
         cmp      #$05
         bcs      LD11F
         asl
         tax
         lda      #$00
         sta      INTRUPT1 - 2,X
         sta      INTRUPT1 - 1,X
         clc
         rts
;
;
;   Interrupt handler
;   save A,X,Y,stack,Preg
;   and return address
;
LD13A    lda      L45
         sta      INTAREG
         stx      INTXREG
         sty      INTYREG
         tsx
         stx      INTSREG
         pla
         sta      INTPREG
         pla
         sta      INTADR
         pla
         sta      INTADR+1
;
;   if stack more than half full,
;   save 16 items off top
;
         txs
         lda      L07F8
         sta      LD1C2+2
         tsx
         bmi      >2
         ldy      #$0F
^1       pla      
         sta      LF0AF,Y
         dey
         bpl      <1
;
;   save $FA-$FF (allowed for use
;   by interrupt driver)
;
^2       ldx      #$FA
^3       lda      L00,X
         sta      LEFA5,X
         inx
         bne      <3
;
;   call installed interrupt
;   driver
;   if driver returns with carry
;   set, then interrupt condition
;   was wrong for that driver -
;   try the next one
;
         lda      INTRUPT1+1
         beq      >4
         jsr      IRQHNDL1
         bcc      GOODINT
;
^4       lda      INTRUPT2+1
         beq      >5
         jsr      IRQHNDL2
         bcc      GOODINT
;
^5       lda      INTRUPT3+1
         beq      >6
         jsr      IRQHNDL3
         bcc      GOODINT
;
^6       lda      INTRUPT4+1
         beq      >7
         jsr      IRQHNDL4
         bcc      GOODINT
;
;   none of the interrupt drivers
;   could handle the interrupt
;   serious error
;
^7       lda      #NOTVALID
         jsr      SYSDEATH              ;does not return
;
;   interrupt handled by routine
;   return, restoring ZPAGE used
;   ($FA-$FF) stack if necessary
;   and registers et al
;
GOODINT  ldx      #$FA
^8       lda      LEFA5,X
         sta      L00,X
         inx
         bne      <8
;
;   restore stack if locations
;   were saved
;
         ldx      INTSREG
         bmi      >0
         ldy      #$00
^9       lda      LF0AF,Y
         pha
         iny
         cpy      #$10
         bne      <9
;
;   get registers, re-enable ROM
;   on current card
;
^0       ldy      INTYREG
         ldx      INTXREG
         lda      ROMSOFF
LD1C2    lda      SLOT1
         lda      LD1C2+2
         sta      L07F8
         jmp      IRQXIT
;
;   indirect jumps to interrupt
;   handlers
;
IRQHNDL1 jmp      (INTRUPT1)
IRQHNDL2 jmp      (INTRUPT2)
IRQHNDL3 jmp      (INTRUPT3)
IRQHNDL4 jmp      (INTRUPT4)
;
;
;
LD1DA    sta      SERR
         pla
         pla
         lda      SERR
         sec
         rts
;
;
;   SYSDEATH routine
;
LD1E4    lda      #$00
LD1E6    tax      
         sta      D40COL
         lda      TEXT
         lda      MIX
         lda      PAGE1
         lda      LORES
;
         ldy      #$27
^1       lda      #" "
         sta      LINE22,Y
         lda      LEFDE,Y
         sta      LINE23,Y
         dey
         bpl      <1
         txa
         beq      LD239
         lda      #"-"
         sta      LINE23+33
         lda      #"E"
         sta      LINE23+34
         lda      #"R"
         sta      LINE23+35
         sta      LINE23+36
         txa
         lsr
         lsr
         lsr
         lsr
         ora      #"0"
         cmp      #"9"+1
         bcc      >2
         adc      #$06
^2       sta      LINE23+38
         txa
         and      #$0F
         ora      #"0"
         cmp      #"9"+1
         bcc      >3
         adc      #6
^3       sta      LINE23+39
LD239    jmp      LD239
;
;
         sbt      "MLI file handler dispatch"
         pag
;
;
;   is an opcode in the range
;   $C0-$D3
;   get address of routine to
;   handle operation, call it
;
FILHNDLR stx      LF077
;
;   LEF8D is a table of indices
;   and states for each function
;
;   b7 = 1   get and parse name
;   b6 = 1   get unit number
;   b5 = 1   file needs new date/time
;
         lda      LEF8D,X
         asl
         sta      LF073
         and      #$3F
         tax
         lda      LEF65,X
         sta      DEVJMP
         lda      LEF65+1,X
         sta      DEVJMP+1
         lda      #$20
         sta      LF074
;
;   if b7 = 1, then get pathname
;   and check for validity
;
         bcc      >7
         jsr      PARSENAM
         bcs      LD278
;
;   if b6 = 1, then get unit
;   number and check
;
^7       asl      LF073
         bcc      >8
         jsr      LD3C5
         bcs      LD278
;
;   if b5 = 1, then file will be
;   updated or created and needs
;   new system time
;
^8       asl      LF073
         bcc      >9
         jsr      DATETIME
;
^9       jsr      GOFUNCT
         bcc      >1
;
;   err in pre-parse
;
LD278    jsr      SYSERR                ;does not return
;
;
;   good call
;   return
;
^1       rts      
;
;   call MLI function
;
GOFUNCT  jmp      (DEVJMP)
;
;
;
;   get and check pathname
;
;   address of pathname is in
;   parameter list
;
PARSENAM ldy      #1
         lda      (PARMS),Y
         sta      PTR
         iny
         lda      (PARMS),Y
         sta      PTR+1
;
;   alternate entry point
;   address of pathname is in PTR
;
PARSNAM2 ldx      #0
         ldy      #0
         stx      HASSLASH
         stx      PATHNAME
;
;   first byte is length
;   must be non-zero, max of 64
;
         lda      (PTR),Y
         beq      BADPARS               ;0 chars not allowed
         cmp      #64+1
         bcs      BADPARS               ;too long
         sta      NAMLEN
         inc      NAMLEN
;
;   if first char is "/" then
;   this is a complete pathname
;   specification
;
         iny
         lda      (PTR),Y
         ora      #$80
         cmp      #"/"
         bne      >1
         sta      HASSLASH
         iny
;
;   parse chars in name
;   save index to start of last
;   partial path, set flag
;
^1       lda      #$FF
         sta      PATHNAME,X
         sta      PARTPATH              ;0 chars in this partial
         stx      PARTLNDX              ;partial starts here
;
;   parse char loop
;
^2       cpy      NAMLEN
         bcs      LD2F4                 ;all done
;
;   get char, check it
;
         lda      (PTR),Y
         and      #$7F
         inx
         iny
         cmp      #'/'
         beq      LD309                 ;another partial path
         cmp      #'a'
         bcc      >3
         and      #$5F                  ;lower to upper case
;
^3       sta      PATHNAME,X            ;save pathname char
         inc      PARTPATH              ;check partials flag
         bne      >4                    ;normal
         inc      PARTPATH              ;is first char after "/"
         bne      >5                    ;always taken
;
;   valid chars at this point
;   are "." "0"-"9" and "A"-"Z"
;
^4       cmp      #'.'
         beq      <2
         cmp      #'0'
         bcc      BADPARS
         cmp      #'9'+1
         bcc      <2
;
;   after a "/" the only valid
;   chars are "A" - "Z"
;
^5       cmp      #'A'
         bcc      BADPARS
         cmp      #'Z'+1
         bcc      <2
;
;   error somewhere in the pathname
;   return BADPATH error
;
BADPARS  sec      
         lda      #BADPATH
         rts
;
;
;   got all chars from name
;
LD2F4    lda      #$00
         bit      PARTPATH              ;"/" last char?
         bpl      >6                    ;no
         sta      PARTPATH              ;yes -- 0 chars in partial
         dex
;
^6       inx      
         sta      PATHNAME,X
         beq      BADPARS               ;0 chars is bad
         stx      NAMLEN                ;is "real" name length
         tax
;
;
LD309    lda      PARTPATH
         cmp      #16
         bcs      BADPARS               ;15 chars max in partial path
;
         stx      LF07D
         ldx      PARTLNDX              ;save length in place of "/"
         sta      PATHNAME,X            ;before partial path
         ldx      LF07D
         bne      <1
         clc
         lda      HASSLASH
         bne      >8
         lda      PFIXPTR
         beq      BADPARS
^8       rts      
;
;
;
LD32A    jsr      PARSENAM
         bcc      >1
         ldy      PATHNAME
         bne      LD380
         sty      PFIXPTR
         clc
         rts
;
;
^1       jsr      LD798
         bcc      >2
         cmp      #$40
         bne      LD380
^2       lda      LF01F
         and      #%11010000            ;check b7 b6 b4
         eor      #%11010000            ;all zero?
         bne      LD37E                 ;no
         ldy      LF07C
         bne      >3
         lda      PFIXPTR
^3       tay      
         sec
         sbc      LF05E
         cmp      #$C0
         bcc      BADPARS
         tax
         sta      PFIXPTR
         lda      LF019
         sta      LF05F
         lda      LF030
         sta      LF060
         lda      LF031
         sta      LF061
;
^4       lda      PATHNAME,Y
         sta      PATHNAME,X
         iny
         inx
         bne      <4
         clc
         rts
;
;
LD37E    lda      #$4B
LD380    sec      
         rts
;
;
;
;
LD382    clc      
         ldy      #$01
         lda      (PARMS),Y
         sta      L4E
         iny
         lda      (PARMS),Y
         sta      L4F
         lda      #$00
         sta      LF09B
         lda      #$40
         sta      LF09A
         jsr      LEE6C
         bcs      LD380
         ldy      #$00
         lda      PFIXPTR
         tax
         beq      >5
         eor      #$FF
         adc      #$02
^5       sta      (L4E),Y
         beq      >9
;
;
^6       iny      
         lda      PATHNAME,X
^7       sta      (L4E),Y
         and      #$F0
         bne      >8
         lda      #'/'
         bne      <7
;
^8       inx      
         bne      <6
         iny
         lda      #'/'
         sta      (L4E),Y
^9       clc      
         rts
;
;
;
;
LD3C5    ldy      #1
         lda      (PARMS),Y
         beq      LD426
         cmp      #$09
         bcs      LD426
         pha
         sbc      #$00
         lsr
         ror
         ror
         ror
         sta      LF052
         tay
         pla
         cmp      LF300,Y
         bne      LD421
LD3E0    lda      LF300+11,Y
         jsr      LEE26
         ldx      LF09E
         beq      LD412
         stx      L4B
         inx
         inx
         stx      PTR+1
         lda      LF300+1,Y
         sta      DEVNUM
         lda      LF09D
         sta      L4A
         sta      PTR
^1       tax      
         lda      LF210,X
         cmp      LF300+1,Y
         beq      LD417
^2       txa      
         clc
         adc      #$20
         bcc      <1
         lda      #$0A
         jsr      SYSDEATH              ;does not return
;
;
LD412    lda      #$0B
         jsr      SYSDEATH              ;does not return
;
;
LD417    lda      LF200,X
         beq      <2
         stx      LF051
         clc
         rts
;
;
LD421    lda      #0
         sta      LF052,Y
;
LD426    lda      #$43
         sec
         rts
;
;
;
LD42A    jsr      LE403
         lda      #$00
         sta      LF09A
         sta      LF09B
         ldy      #$01
         lda      (PARMS),Y
         beq      >1
         lda      #$10
         sta      LF09A
         bne      >2
^1       lda      #$01
         sta      LF09B
^2       jsr      LEE6C
         bcs      >5
         lda      #$00
         ldy      LF09A
^3       dey      
         sta      (L4E),Y
         bne      <3
         sta      LF07A
         ldy      #$01
         lda      (PARMS),Y
         and      #$F0
         bne      LD480
         jsr      LDA57
^4       stx      LF07D
         lda      LF08A,X
         jsr      LD480
         lda      LF07A
         clc
         adc      #$10
         sta      LF07A
         ldx      LF07D
         dex
         bpl      <4
         lda      #$00
         clc
^5       rts      
;
;
;
LD480    sta      DEVNUM
         jsr      LDA69
         bcs      >8
         lda      #0
         sta      BLOCK+1
         lda      #2
         sta      BLOCK
         jsr      LDDE1
         bcs      >8
         ldx      LF051
         lda      LF200,X
         beq      >6
         lda      LF210+1,X
         bmi      >7
^6       jsr      LDAC4
         bcs      >8
         lda      #$57
         bit      LF075
         bmi      >8
^7       ldx      LF051
         jsr      LDB1C
         lda      #$2E
         bcc      >0
^8       pha      
         jsr      LD4EB
         pla
         iny
         sta      (L4E),Y
         cmp      #$57
         bne      >9
         iny
         ldx      LF076
         lda      LF210,X
         sta      (L4E),Y
         lda      #$00
         sta      LF075
         lda      #$57
^9       sec      
         rts
;
;
^0       lda      LF200,X
         sta      LF078
         ldy      LF07A
^1       lda      LF200,X
         sta      (L4E),Y
         inx
         iny
         dec      LF078
         bpl      <1
;
;
LD4EB    ldy      LF07A
         lda      DEVNUM
         ora      (L4E),Y
         sta      (L4E),Y
         clc
         rts
;
;
;
LD4F7    jsr      LD7AB
         bcs      >4
         lda      #$47
^3       sec      
         rts
;
;
^4       cmp      #$46
         bne      <3
         ldy      #$07
         lda      (PARMS),Y
         cmp      #$04
         bcc      >5
         cmp      #$0D
         bne      >6
^5       lda      DEVNUM
         jsr      LE65B
         bcs      >7
         lda      LF05B
         beq      LD524
         jmp      LD5B6
;
;
^6       lda      #$4B
         sec
^7       rts      
;
;
LD524    lda      LF006
         ora      LF007
         bne      >9
         lda      #$49
         sec
         rts
;
;
^9       lda      BLOCK
         pha
         lda      BLOCK+1
         pha
         jsr      LDCA9
         tax
         pla
         sta      BLOCK+1
         pla
         sta      BLOCK
         txa
         bcs      <7
         sta      LF602
         sty      LF603
         jsr      LDDDD
         bcs      <7
         ldx      #$01
^1       lda      BLOCK,X
         sta      LF600,X
         lda      LF602,X
         sta      BLOCK,X
         dex
         bpl      <1
         inx
         txa
^2       sta      LF602,X
         sta      LF700,X
         inx
         bne      <2
         jsr      LDDDD
         bcs      <7
         lda      LF006
         sta      BLOCK
         lda      LF007
         sta      BLOCK+1
         jsr      LDDE1
         ldx      LF008
         lda      /LF600
         sta      PTR+1
         lda      #$04
LD583:
         clc
         dex
         beq      LD590
         adc      LF009
         bcc      LD583
         inc      PTR+1
         bcs      LD583
LD590:
         sta      PTR
         ldy      #$13
LD594:
         lda      (PTR),Y
         adc      LEF8E,Y
         sta      (PTR),Y
         iny
         tya
         eor      #$18
         bne      LD594
         jsr      LDDDD
         bcs      LD5B5
         jmp      LD4F7
;
;
;
LD5A9    lda      #0
         tax
LD5AC:
         sta      LF600,X
         sta      LF700,X
         inx
         bne      LD5AC
LD5B5:
         rts
;
;
;
LD5B6    jsr      LD5A9
         ldy      #$0B
LD5BB:
         lda      (PARMS),Y
         sta      LF02F,Y
         txa
         ora      (PARMS),Y
         tax
         dey
         cpy      #$07
         bne      LD5BB
         txa
         bne      LD5D7
         ldx      #$03
LD5CE:
         lda      DATE,X
         sta      LF037,X
         dex
         bpl      LD5CE
LD5D7:
         lda      (PARMS),Y
         cmp      #$04
         lda      #$10
         bcc      LD5E1
         lda      #$D0
LD5E1:
         ldx      LF07A
         ora      PATHNAME,X
         sta      LF01F
         and      #$0F
         tay
         clc
         adc      LF07A
         tax
LD5F2:
         lda      PATHNAME,X
         sta      LF01F,Y
         dex
         dey
         bne      LD5F2
         ldy      #$03
         lda      (PARMS),Y
         sta      LF03D
         iny
         lda      (PARMS),Y
         sta      LF02F
LD609:
         iny
         lda      (PARMS),Y
         sta      LF039,Y
         cpy      #$06
         bne      LD609
         lda      LEFB0
         sta      LF03B
         lda      LEFB1
         sta      LF03C
         lda      #$01
         sta      LF032
         lda      LF01A
         sta      LF044
         lda      LF01B
         sta      LF045
         lda      LF01F
         and      #$E0
         beq      LD66E
         ldx      #$1E
LD639:
         lda      LF01F,X
         sta      LF604,X
         dex
         bpl      LD639
         eor      #$30
         sta      LF604
         ldx      #$07
LD649:
         lda      LEFA6,X
         sta      LF614,X
         lda      LEFB0,X
         sta      LF620,X
         dex
         bpl      LD649
         ldx      #$02
LD65A:
         lda      LF01C,X
         sta      LF627,X
         dex
         bpl      LD65A
         lda      LF011
         sta      LF62A
         lda      #$02
         sta      LF035
LD66E:
         jsr      LDCA9
         bcs      LD6AA
         sta      LF030
         sty      LF031
         sta      BLOCK
         sty      BLOCK+1
         jsr      LDDDD
         bcs      LD6AA
         inc      LF013
         bne      LD68A
         inc      LF014
LD68A:
         jsr      LD6AB
         bcs      LD6AA
         jmp      LDD86
;
;
;
LD692    lda      #$F6
         sta      PTR+1
         lda      #$04
         ldx      LF01E
LD69B:
         clc
LD69C:
         dex
         beq      LD6A8
         adc      LF011
         bcc      LD69C
         inc      PTR+1
         bcs      LD69B
LD6A8    sta      PTR
LD6AA:
         rts
;
;
;
;
LD6AB    lda      DATE
         beq      LD6BB
         ldx      #$03
LD6B2:
         lda      DATE,X
         sta      LF040,X
         dex
         bpl      LD6B2
LD6BB:
         lda      LF03D
         ora      LF074
         sta      LF03D
         lda      LF019
         sta      DEVNUM
         lda      LF01C
         sta      BLOCK
         lda      LF01D
         sta      BLOCK+1
         jsr      LDDE1
         bcs      LD6AA
         jsr      LD692
         ldy      LF011
         dey
LD6E0:
         lda      LF01F,Y
         sta      (PTR),Y
         dey
         bpl      LD6E0
         lda      LF01A
         cmp      BLOCK
         bne      LD6F6
         lda      LF01B
         cmp      BLOCK+1
         beq      LD70A
LD6F6:
         jsr      LDDDD
         bcs      LD6AA
         lda      LF01A
         sta      BLOCK
         lda      LF01B
         sta      BLOCK+1
         jsr      LDDE1
         bcs      LD6AA
LD70A:
         ldy      #$01
LD70C:
         lda      LF013,Y
         sta      LF625,Y
         dey
         bpl      LD70C
         lda      LF010
         sta      LF622
         jsr      LDDDD
         bcs      LD778
LD720:
         lda      LF604
         and      #$F0
         eor      #$F0
         beq      LD796
         lda      LF627
         sta      BLOCK
         lda      LF628
         sta      BLOCK+1
         lda      LF629
         sta      LF01E
         lda      LF62A
         sta      LF011
         jsr      LDDE1
         bcs      LD778
         jsr      LD692
         lda      DATE
         beq      LD759
         ldx      #$03
         ldy      #$24
LD750:
         lda      DATE,X
         sta      (PTR),Y
         dey
         dex
         bpl      LD750
LD759:
         jsr      LDDDD
         bcs      LD778
         ldy      #$25
         lda      (PTR),Y
         iny
         cmp      BLOCK
         sta      BLOCK
         bne      LD76F
         lda      (PTR),Y
         cmp      BLOCK+1
         beq      LD720
LD76F:
         lda      (PTR),Y
         sta      BLOCK+1
         jsr      LDDE1
         bcc      LD720
LD778:
         rts
LD779:
         lda      #$52
         sec
         rts
;
;
;
LD77D    lda      LF600
         cmp      LEFAE
         bne      LD779
         lda      LF601
         cmp      LEFAF
         bne      LD779
         lda      LF604
         and      #$E0
         cmp      #$E0
         bne      LD779
LD796:
         clc
         rts
;
;
;
LD798    jsr      LD7AB
         bcs      LD7AA
LD79D    ldy      LF011
LD7A0:
         lda      (PTR),Y
         sta      LF01F,Y
         dey
         bpl      LD7A0
         lda      #0
LD7AA:
         rts
;
;
;
LD7AB    jsr      LD92F
         bcs      LD802
         bne      LD7DA
         lda      LD828+2
         sta      PTR+1
         lda      #$04
         sta      PTR
         ldy      #$1F
LD7BD:
         lda      (PTR),Y
         sta      LF01F,Y
         dey
         cpy      #$17
         bne      LD7BD
LD7C7:
         lda      LEFA8,Y
         sta      LF01F,Y
         dey
         cpy      #$0F
         bne      LD7C7
         lda      #$D0
         sta      LF01F
         lda      #$40
         rts
LD7DA:
         lda      #$00
         sta      LF05B
         sec
LD7E0:
         lda      #$00
         sta      LF057
         jsr      LD8D8
         bcc      LD84F
         lda      LF058
         sbc      LF057
         bcc      LD7FB
         bne      LD804
         cmp      LF059
         beq      LD823
         bne      LD804
LD7FB:
         dec      LF059
         bpl      LD804
LD800:
         lda      #$51
LD802:
         sec
         rts
LD804:
         sta      LF058
         lda      LD828+2
         sta      PTR+1
         lda      LF602
         bne      LD816
         cmp      LF603
         beq      LD800
LD816:
         sta      BLOCK
         lda      LF603
         sta      BLOCK+1
         jsr      LDDE1
         bcc      LD7E0
         rts
;
;
;
;
;
         chn      "PR.4"
